home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The PC-SIG Library 10
/
The PC-Sig Library - Shareware for the IBM PC and Compatibles (PC-SIG)(Tenth Edition Disks 1-2804)(1991).iso
/
PC_SIGCD
/
20
/
9
/
DISK2092.ZIP
/
RBBS-UTL.ZIP
/
UTIL
/
MAKEFIDX.BAS
< prev
next >
Wrap
BASIC Source File
|
1989-11-05
|
9KB
|
314 lines
DECLARE SUB TRIM (TRIM.PARM$)
DECLARE SUB BRKFNAME (FILENAME$, DRVPATH$, PREFIX$, EXTENSION$, FOR.JOINING%)
DECLARE SUB TRIMTRAIL (TRIM.PARM$, TRIM.THIS$)
DECLARE SUB FINDLAST (LOOK.IN$, LOOK.FOR$, WHERE.FOUND%, NUM.FINDS%)
DEFINT A-Z
DIM FileSpec$(255)
DIM FileDir$(255)
DIM LocationIndex$(999)
TRUE = -1
FALSE = 0
WriteMode$ = "Replace"
NameFile$ = "FIDX.DEF"
LocationFile$ = "LIDX.DEF"
SHARING = FALSE
NumLocations = 0
NumFileSpecs = 0
NumFileDirs = 0
ConfigFile$ = "MAKEFIDX.CFG"
PassedArguments$ = COMMAND$
PassedArguments$ = UCASE$(PassedArguments$)
X = INSTR(PassedArguments$,"/B")
RunBatch = (X > 0)
IF RunBatch THEN
PassedArguments$ = LEFT$(PassedArguments$, X-1) + RIGHT$(PassedArguments$,Len(PassedArguments$)-X-1)
END IF
IF PassedArguments$ <> "" THEN
ConfigFile$ = PassedArguments$
END IF
ON ERROR GOTO 40000
IF SHARING THEN
OPEN ConfigFile$ FOR INPUT SHARED AS #1
ELSE
OPEN ConfigFile$ FOR INPUT AS #1
END IF
ON ERROR GOTO 0
WHILE NOT EOF(1)
LINE INPUT #1, A$
X$ = LEFT$(A$, 1)
IF X$ <> "" AND X$ <> "*" THEN
A$ = UCASE$(A$)
IF LEFT$(A$,11) = "/WRITEMODE=" THEN
WriteMode$ = MID$(A$,12)
CALL TRIM (WriteMode$)
END IF
IF LEFT$(A$, 10) = "/NAMEFILE=" THEN
NameFile$ = MID$(A$, 11)
CALL TRIM(NameFile$)
END IF
IF LEFT$(A$, 14) = "/LOCATIONFILE=" THEN
LocationFile$ = MID$(A$, 15)
CALL TRIM(LocationFile$)
END IF
IF LEFT$(A$, 10) = "/FILESPEC=" THEN
X$ = MID$(A$, 11)
CALL TRIM(X$)
NumFileSpecs = NumFileSpecs + 1
FileSpec$(NumFileSpecs) = X$
END IF
IF LEFT$(A$, 9) = "/FILEDIR=" THEN
X$ = MID$(A$, 10)
CALL TRIM(X$)
NumFileDirs = NumFileDirs + 1
FileDir$(NumFileDirs) = X$
END IF
END IF
WEND
CLOSE 1
Replacing = (LEFT$(WriteMode$, 1) = "R")
PRINT "MAKEFIDX version 1.0 copyright (c) 1989 by Ken Goosens"
PRINT "an RBBS utility to make files for fast directory searches"
PRINT
PRINT "On this run"
IF Replacing THEN
PRINT "Overwriting data files"
ELSE
PRINT "Adding to data files"
END IF
PRINT "Configuration file used ....... ";ConfigFile$
PRINT "Name of list of files ......... "; NameFile$
PRINT "Name of list of locations ..... "; LocationFile$
PRINT "# of DOS directories to process"; NumFileSpecs
PRINT "# of file lists to process ...."; NumFileDirs
PRINT
IF NOT RunBatch THEN
INPUT "A to abort, anything else runs"; ANS$
ANS$ = UCASE$(ANS$)
IF ANS$ = "A" THEN END
END IF
'NumFileSpecs = 2
'FileSpec$(1) = "C:\TEMP\"
'FileSpec$(2) = "C:\UTILS\"
IF Replacing THEN
ON ERROR GOTO 40100
KILL NameFile$
KILL LocationFile$
ON ERROR GOTO 0
ELSE
IF SHARING THEN
OPEN LocationFile$ FOR INPUT SHARED AS #1
ELSE
OPEN LocationFile$ FOR INPUT AS #1
END IF
PRINT "Loading existing locations..."
WHILE NOT EOF(1)
LINE INPUT #1, A$
CALL TRIM(A$)
NumLocations = NumLocations + 1
LocationIndex$(NumLocations) = A$
WEND
CLOSE 1
PRINT STR$(NumLocations); " locations loaded"
END IF
IF SHARING THEN
OPEN NameFile$ FOR RANDOM SHARED AS #2 LEN = 18
OPEN LocationFile$ FOR RANDOM SHARED AS #3 LEN = 66
ELSE
OPEN NameFile$ FOR RANDOM AS #2 LEN = 18
OPEN LocationFile$ FOR RANDOM AS #3 LEN = 66
END IF
FIELD 2, 18 AS NameRec$
FIELD 3, 66 AS LocationRec$
MID$(NameRec$, 17, 2) = CHR$(13) + CHR$(10)
MID$(LocationRec$, 64, 3) = "." + CHR$(13) + CHR$(10)
NumRecsNameFile = LOF(2) / 18
NumRecsLocationFile = LOF(3) / 66
InFile$ = "IDX.$$$"
FOR ix = 1 TO NumFileSpecs
SHELL "DIR " + FileSpec$(ix) + " > IDX.$$$"
PRINT "Processing filespec "; FileSpec$(ix)
GOSUB ProcessFile
NEXT
FOR ix = 1 TO NumFileDirs
InFile$ = FileDir$(ix)
PRINT "Processing file list "; FileDir$(ix)
GOSUB ProcessFile
NEXT
END
ProcessFile:
IF SHARING THEN
OPEN InFile$ FOR INPUT SHARED AS #1
ELSE
OPEN InFile$ FOR INPUT AS #1
END IF
WHILE NOT EOF(1)
LINE INPUT #1, A$
X = INSTR(A$, "Directory of ")
IF X > 0 THEN
DrivePath$ = MID$(A$, X + 12)
CALL TRIM(DrivePath$)
IF INSTR(DrivePath$, "\") > 0 THEN
IF RIGHT$(DrivePath$, 1) <> "\" THEN
DrivePath$ = DrivePath$ + "\"
END IF
END IF
CurrentDrivePath$ = DrivePath$
GOSUB SetLocIndex
GOTO DoneEntry
END IF
IF INSTR(" .", LEFT$(A$, 1)) > 0 THEN
GOTO DoneEntry
END IF
X = INSTR(A$, " ")
IF X < 13 THEN
FILENAME$ = LEFT$(A$, 12)
IF INSTR(FILENAME$, ".") = 0 AND MID$(FILENAME$, 9, 1) = " " AND MID$(FILENAME$, 10, 1) <> " " THEN
MID$(FILENAME$, X) = "." + MID$(FILENAME$, 10) + SPACE$(9 - X)
ELSE
FILENAME$ = LEFT$(A$, X - 1)
END IF
GOSUB AddFileName
GOTO DoneEntry
END IF
FILENAME$ = LEFT$(A$, X - 1)
GOSUB AddFileName
DoneEntry:
WEND
CLOSE 1
RETURN
SetPathName:
CALL BRKFNAME(FILENAME$, FileDrivePath$, FilePrefix$, FileExt$, TRUE)
IF FileDrivePath$ <> "" THEN
CurrentDrivePath$ = FileDrivePath$
GOSUB SetLocIndex
FILENAME$ = FilePrefix$ + FileExt$
ELSE
CurrentDrivePath$ = DrivePath$
END IF
RETURN
AddFileName:
GOSUB SetPathName
MID$(NameRec$, 1, 16) = SPACE$(16)
MID$(NameRec$, 1, 12) = FILENAME$
X$ = MID$(STR$(Location), 2)
X$ = SPACE$(4 - LEN(X$)) + X$
MID$(NameRec$, 13, 4) = X$
NumRecsNameFile = NumRecsNameFile + 1
PUT 2, NumRecsNameFile
RETURN
SetLocIndex:
IF CurrentDrivePath$ = LocationIndex$(Location) THEN RETURN
LocationIndex$(NumRecsLocationFile + 1) = CurrentDrivePath$
Location = 1
WHILE CurrentDrivePath$ <> LocationIndex$(Location)
Location = Location + 1
WEND
IF Location > NumRecsLocationFile THEN
NumRecsLocationFile = Location
MID$(LocationRec$, 1, 63) = SPACE$(63)
MID$(LocationRec$, 1, 63) = CurrentDrivePath$
PUT 3, NumRecsLocationFile
END IF
RETURN
40000 PRINT "Missing configuration file "; ConfigFile$
END
40100 RESUME NEXT
SUB BRKFNAME (FILENAME$, DRVPATH$, PREFIX$, EXTENSION$, FOR.JOINING) STATIC
FILENAME$ = UCASE$(FILENAME$)
DRVPATH$ = ""
PREFIX$ = ""
EXTENSION$ = ""
CALL TRIMTRAIL(FILENAME$, "\")
L = LEN(FILENAME$)
IF L < 1 THEN EXIT SUB
CALL FINDLAST(FILENAME$, "\", X, Y)
IF X < 1 THEN
IF MID$(FILENAME$, 2, 1) = ":" THEN
DRVPATH$ = LEFT$(FILENAME$, 1)
S = 3
ELSE
S = 1
END IF
ELSE
DRVPATH$ = LEFT$(FILENAME$, X - 1)
S = X + 1
IF Y = 1 THEN
DRVPATH$ = DRVPATH$ + "\"
END IF
END IF
X = INSTR(FILENAME$ + ".", ".")
IF X < L THEN
EXTENSION$ = MID$(FILENAME$, X + 1, 3)
END IF
IF S <= L THEN
IF X >= S THEN
PREFIX$ = MID$(FILENAME$, S, X - S)
END IF
END IF
IF NOT FOR.JOINING THEN EXIT SUB
IF LEN(DRVPATH$) = 1 THEN
IF DRVPATH$ <> "\" THEN
DRVPATH$ = DRVPATH$ + ":"
END IF
END IF
IF INSTR(DRVPATH$, "\") > 0 AND RIGHT$(DRVPATH$, 1) <> "\" THEN DRVPATH$ = DRVPATH$ + "\"
IF LEN(EXTENSION$) > 0 THEN EXTENSION$ = "." + EXTENSION$
END SUB
SUB FINDLAST (LOOK.IN$, LOOK.FOR$, WHERE.FOUND, NUM.FINDS) STATIC
WHERE.FOUND = INSTR(LOOK.IN$, LOOK.FOR$)
NUM.FINDS = -(WHERE.FOUND > 0)
NEXT.FOUND = INSTR(WHERE.FOUND + 1, LOOK.IN$, LOOK.FOR$)
WHILE NEXT.FOUND > 0
NUM.FINDS = NUM.FINDS + 1
WHERE.FOUND = NEXT.FOUND
NEXT.FOUND = INSTR(WHERE.FOUND + 1, LOOK.IN$, LOOK.FOR$)
WEND
END SUB
SUB TRIM (TRIM.PARM$) STATIC
L = INSTR(TRIM.PARM$, " ")
IF L < 1 THEN EXIT SUB
IF L = 1 THEN
WHILE LEFT$(TRIM.PARM$, 1) = " "
TRIM.PARM$ = RIGHT$(TRIM.PARM$, LEN(TRIM.PARM$) - 1)
WEND
END IF
CALL TRIMTRAIL(TRIM.PARM$, " ")
END SUB
SUB TRIMTRAIL (TRIM.PARM$, TRIM.THIS$) STATIC
IF RIGHT$(TRIM.PARM$, 1) <> TRIM.THIS$ THEN EXIT SUB ' KG081003
J = LEN(TRIM.PARM$) - 1 ' KG081003
108 IF J > 0 THEN
IF MID$(TRIM.PARM$, J, 1) = TRIM.THIS$ THEN
J = J - 1
GOTO 108
END IF
END IF
TRIM.PARM$ = LEFT$(TRIM.PARM$, J) ' KG081003
END SUB